.TITLE	KXDRV
	.IDENT	/2.12/
;
;
; Copyright (c) 1995-1999 by Mentec, Inc., U.S.A.
; All rights reserved
;
;
;	THIS SOFTWARE IS FURNISHED  UNDER A LICENSE AND MAY
;	BE USED  AND COPIED  ONLY IN  ACCORDANCE  WITH  THE
;	TERMS OF SUCH LICENSE AND WITH THE INCLUSION OF THE
;	ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY OTHER
;	COPIES  THEREOF MAY  NOT  BE PROVIDED  OR OTHERWISE
;	MADE  AVAILABLE TO  ANY OTHER  PERSON.  NO TITLE TO
;	AND   OWNERSHIP   OF  THE   SOFTWARE   IS   HEREBY 
;	TRANSFERRED.
;
;	THE  INFORMATION IN  THIS SOFTWARE  IS  SUBJECT  TO
;	CHANGE WITHOUT  NOTICE AND  SHOULD NOT BE CONSTRUED
;	AS  A  COMMITMENT BY DIGITAL EQUIPMENT CORPORATION.
;
;	DIGITAL  ASSUMES NO  RESPONSIBILITY  FOR THE USE OR 
;	RELIABILITY  OF ITS  SOFTWARE ON  EQUIPMENT THAT IS
;	NOT SUPPLIED BY DIGITAL.
;
; PAUL K. M. WEISS 
; K. L. Noel
;
; MODIFIED BY:
;
;	K. L. NOEL		10-April-1989		2.01
;
;		KLN140 - Modify connect entry point and online entry points for 
;		      network remote system
;
;	Paul K. M. Weiss	22-May-1989		2.02
;
;		PKW176	- Schedule CPRNET instead of interrupting VAX
;
;	Paul K. M. Weiss	7-Jun-1989		2.03
;
;		PKW177	- Use unit number instead of tiuc/vucb
;
;	R. D. Haney		30-May-1989		2.04
;
;		RDH186	Clear user carry before testing returned status
;
;	Paul K. M. Weiss	19-Jul-1989		2.05
;
;		PKW181	Set up $CPMXB for buffering things in cpr packets
;
;	K. L. Noel		28-Aug-1989		2.06
;
;		KLN146  Clear reserved byte in copy of ring in header
;
;	K. L. Noel		14-Sep-1989		2.07
;
;		KLN147  Move task index field
;
;	K. L. Noel		14-Nov-89		2.08
;
;		KLN150 Check for offline terminal for VMS initiated commands
;
;	Paul K. M. Weiss	25-JAN-1990		2.09
;
;		PKW189	- Don't reschedule on HT$DSB packet
;
;	Paul K. M. Weiss	16-Apr-1990		2.10
;
;		PKW192 - Disable packet buffering
;
;	Sergey Tetelbaum	10-Jan-1991		2.11
;
;		ST001 - To DEACB Exec Memory Pool
;
;	Sergey Tetelbaum	 7-Mar-1991		2.12
;
;		ST002 - Include default UIC in task start packet when in
;			nonamed mode.  Previously, when in nonamed mode,
;			the task start packet just included a DDS of "[]",
;			and the AME used its protection UIC as the default
;			directory.  This is incorrect for nonprivileged
;			users and for privileged users when the AME's UIC
;			doesn't match the RSX terminal's protection UIC.
;
; MACRO LIBRARY CALLS
;

	.MCALL	HWDDF$,PKTDF$,SCBDF$,UCBDF$,CPRDF$
	HWDDF$			;DEFINE HARDWARE REGISTERS
	SCBDF$ ,,1		;SCB DEFINITIONS
	UCBDF$ ,,1		;UNIT CONTROL BLOCK OFFSETS
	PKTDF$			;DEFINE I/O PACKET OFFSETS
	CPRDF$			;CPR SPECIFIC DEFINITIONS

;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
;
; THE FOLLOWING TABLE MUST BE THE FIRST THING IN THE DRIVER.  THE EXEC USES
; A VECTORED ENTRY SYSTEM TO THIS MODULE.  ANY CHANGES MADE TO THIS TABLE MUST
; ALSO BE MADE IN THE EXEC MODULE DRSUB
;
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

	.WORD	CPRCON		;UNIT CONNECT ENTRY POINT
	.WORD	CPRALO		;ALLOCATE BUFFER SPACE AND COMMAND RING
	.WORD	CPRDEA		;DEALLOCATE BUFFER SPACE
	.WORD	CPRSEN		;SEND PACKET TO VMS
	.WORD	CPRABO		;ABORT TASK AND CLEANUP OUTSTANDING PACKETS
	.WORD	CPRRCV		;RE-ENTRY POINT IF STALLED DUE TO NO POOL
XXBIAS:	.WORD	0		;XX DRIVER BIAS AND RETURN ADDRESS FOR RETURN
XXALRT:	.WORD	0		;FROM A FAILED ALLOCATION
;
; LOCAL DATA
;
;****TEMPORARY
	TPR1=2
	TPR2=4
	TPR3=6
	KXCSRD=177530
	KXCSRF=177534
	KXJQIR=177532
;****TEMPORARY

RNGBAS:	.WORD	0		;APR BIAS OF RINGS (ALSO OF BASE OF CPRBUF)

CSR:	.WORD	0		;WE SAVE THE CSR - WE DON'T HAVE IT WHEN CALLED

SNDRNG:	.WORD	140000		;CURRENT RSX TO VMS RING ADDRESS
PRVSND:	.WORD	0		;PREVIOUS RSX TO VMS RING ADDRESS
FRSTSN:	.WORD	140000		;FIRST RSX TO VMS RING ADDRESS
WRAPSN:	.WORD	0		;ADDRESS JUST PAST RSX TO VMS RINGS -
				;INDICATES WRAP

RCVRNG:	.WORD	0		;CURRENT VMS TO RSX RING ADDRESS
PRVRCV:	.WORD	0		;PREVIOUS VMS TO RSX RING ADDRESS
FRSTRC:	.WORD	0		;FIRST VMS TO RSX RING ADDRESS
WRAPRC:	.WORD	0		;ADDRESS JUST PAST VMS TO RSX RINGS -
				;INDICATES WRAP

BUFFWT:	.WORD	0		;COUNT OF TASKS WAITING FOR BUFFER SPACE
MAXBUF:	.WORD	0		;MAXIMUM CPRBUF ALLOCATION SIZE
TOPRSX:	.WORD	0		;END OF RSX CONTROLLED AREA
XXWAIT:	.WORD	0		;XX DRIVER WAIT FLAG WORD
XXR5:	.WORD	0		;XX DRIVER SAVED R5
XXUCB:	.WORD	0		;XX DRIVER GENERIC UCB ADDRESS
XXNET:	.WORD	0		;XX DRIVER GENERIC NETWORK UCB ADDRESS

UNITBL:	.BLKW	128.		;MAKE SURE WE HAVE ENOUGH
;
; DRIVER DISPATCH TABLE
;

	DDT$	KX,1,,,,NEW=Y	;GENERATE DISPATCH TABLE - ALWAYS ONE CONTROLLER

	.PAGE
	.SBTTL	KXKRB - CONTROLLER INITIALIZATION ROUTINE
;
;	KXKRB - CONTROLLER INITIALZATION ROUTINE.
;
;	THIS ROUTINE ASSUMES THAT THE TOP FOUR WORDS OF PHYSICAL MEMORY HAVE
;	BEEN SET UP WITH THE FOLLOWING VALUES:
;
;		+-------------------------------------------------------+
;		| 	      SIZE IN 32 WORD BLOCKS OF CPRBUF 		|
;		+-------------------------------------------------------+
;		| 		# OF RSX/KXJ -> VAX/VMS RINGS 		|
;		+-------------------------------------------------------+
;		| 		# OF VAX/VMS -> RSX/KXJ RINGS	 	|
;		+-------------------------------------------------------+
;		| SIZE IN 32 WORD BLOCKS OF RSX CONTROLLED BUFFER SPACE |
;		+-------------------------------------------------------+
;
;	USING THESE VALUES, THIS ROUTINE SETS UP CPRBUF IN THE FOLLOWING MANNER:
;
;
;TOP OF MEMORY	+-------------------------------------------------------+
;		|							|
;		|							|
;		|		VMS CONTROLLED BUFFER AREA		|
;		+-------------------------------------------------------+
;		|							|
;		|							|
;		|							|
;		|		RSX CONTROLLED BUFFER AREA		|
;		+-------------------------------------------------------+
;		|		VMS -> RSX COMMAND RINGS		|
;		+-------------------------------------------------------+
;		|		RSX -> VMS COMMAND RINGS		|
;BASE OF CPRBUF	+-------------------------------------------------------+
;
;	FOR THE KXJ CASE:
;
;	THIS ROUTINE SENDS AN INTERRUPT TO VMS NOTIFYING IT THAT
;	THE ABOVE INFORMATION IS IN PLACE AT THE TOP OF MEMORY.  WHEN VMS
;	RECEIVES THIS NOTIFICATION, IT SETS UP ITS OWN REFERENCES TO CPRBUF IN
;	EXACTLY THE SAME MANNER.
;
;	THE FIFTH WORD FROM THE TOP OF SHARED MEMORY IS SET UP AS THE APR BIAS
;	OF THE BASE OF CURRENTLY SHARED MEMORY, WHICH VMS USES TO CHECK ACCESS
;
; INPUTS
;
;	R4 = DCB ADDRESS
;	R3 = CTB ADDRESS
;	R2 = KRB ADDRESS
;	0(SP) = RETURN ADDRESS FOR IMMEDIATE COMPLETION
;	2(SP) = RETURN ADDRESS FOR CALLER OF EXEC ROUTINE
;	C = 1 TRANSITION TO OFF-LINE REQUESTED
;	C = 0 TRANSITION TO ON-LINE REQUESTED
;	SUCCESS ASSUMED, $SCERR FILLED IN WITH ERROR CODE IF NEEDED

KXKRB::
	BCC	1$			;IF CC ONLINE REQUEST
	MOVB	#IE.DNR,$SCERR		;SET DEVICE NOT READY
	RETURN
1$:
	MOV	#128.,R0		; NUMBER OF UNITS
	MOV	#UNITBL,R1		; UNIT TABLE
2$:	CLR	(R1)+			; CLEAR UNIT TABLE
	SOB	R0,2$			; ALL WORDS
	MOV	K.CSR(R2),R4		; NOW GET THE CSR
	MOV	R4,CSR			; SAVE THE CSR-WE DON'T HAVE IT LATER
	MOV	@#KISAR5,$KXBAS		; SAVE DRIVER BASE ADDRESS FOR THE EXEC

;
;The following commented out lines enable buffering within the CPR packet. 
;This code is disabled by the CLR instruction.  There is a bug in the buffering
;somewhere, such that buffered writes copy the data into another random portion
;of RSX memory.  Since there is little if any performance improvement gained by
;the buffering in the KXJ case (it was originally written for the network case),
;the code is simply being disabled. 
;
	CLR	$CPMXB			; DISABLE CPR PACKET BUFFERING
;	MOV	#512.,$CPMXB		; ASSUME NETWORK SYSTEM
;	BIT	#F5.NRT,$FMSK5		; IS THIS A REMOTE NETWORK SYSTEM?
;	BNE	15$			; IF NE, YES
;	MOV	#128.,$CPMXB		; CATCH TERMINAL QIOS ANYWAY
;
;	FIRST TELL VMS THAT THE TOP FOUR WORD HAVE BEEN SET UP, AND IT
;	CAN INITIALIZE ITS POINTERS

	BIS	#10010,@#KXCSRD		; ENABLE INTERRUPTS TO AND FROM VMS
	MOV	#RI$RIN,TPR2(R4)	; INDICATE THAT THIS IS A SYNC REQUEST
	MOV	$KXVC1,R0		; GET THE VECTOR
	ADD	#4,R0			; WE WANT THE ALTERNATE VECTOR
	MOV	R0,@#KXJQIR		; INTERRUPT VMS AT THE ALTERNATE VECTOR
10$:	TST	TPR2(R4)		; HAS VMS RECEIVED INTERRUPT?
	BNE	10$			; IF NE NO
;
;	NOW SET UP THE BUFFER AREAS
;
15$:
	MOV	$SYSIZ,@#KISAR6		; GET THE END OF MEMORY
	DEC	@#KISAR6		; BACK UP ONE BLOCK
	MOV	$SYSIZ,RNGBAS		; GET THE SIZE OF MEMORY
	MOV	#140100,R4		; TOP OF MEMORY
	SUB	-(R4),RNGBAS		; SUBTRACT THE # OF BLOCKS TO GET BASE
	MOV	-(R4),R2		; # OF RSX -> VMS COMMAND RINGS
	MOV	-(R4),R1		; # OF VMS -> RSX COMMAND RINGS
	MOV	-(R4),R0		; SIZE OF RSX CONTROLLED BUFFER SPACE
	MOV	R0,MAXBUF		; SAVE SIZE OF RSX CONTROLLED SPACE
	MOV	RNGBAS,@#KISAR6		; NOW MAP CPRBUF IN APR 6
	MOV	#140000,R4		; VIRTUAL ADDRESS TO ACCESS THE RINGS
;
;	INITIALIZE THE RING POINTERS
;
20$:	CLR	(R4)			; MAKE SURE THE SYNCH BIT IS CLEAR
	MOV	R4,PRVSND		; WILL BE THE LAST RING AT LOOP EXIT
	ADD	#R$SIZE,R4		; MOVE TO NEXT RING
	SOB	R2,20$			; LOOP FOR ALL THE RINGS
	MOV	R4,WRAPSN		; THIS IS THE WRAP VALUE FOR THE RINGS,
	MOV	R4,FRSTRC		; THE BEGINNING OF THE RECEIVE RINGS,
	MOV	R4,RCVRNG		; AND THE CURRENT RECEIVE RING
30$:	CLR	(R4)			; MAKE SURE THAT SYNCH BIT IS CLEAR
	MOV	R4,PRVRCV		; WILL BE LAST RING AT LOOP EXIT
	ADD	#R$SIZE,R4		; MOVE TO NEXT RING
	SOB	R1,30$			; LOOP FOR ALL RECEIVE RINGS
	MOV	R4,WRAPRC		; WRAP VALUE FOR RECEIVE RINGS
	BIC	#160000,R4		; CLEAR OUT THE APR BIAS
	ADD	#77,R4			; ROUND TO NEXT 32-WORD BLOCK
	ASH	#-6,R4			; MAKE INTO A BLOCK NUMBER
	ADD	R4,@#KISAR6		; MAP IT
	MOV	RNGBAS,TOPRSX		; COPY RING BASE TO TOPRSX
	ADD	R4,TOPRSX		; ADD THE RING AREA
	ADD	R0,TOPRSX		; AND THE SIZE OF RSX CONTROLLED SPACE
	DEC	TOPRSX			; BACK OFF ONE SO SUBTRACTION WORKS
	MOV	@#KISAR6,$CPRBF		; SET UP BUFFER LISTHEAD
	CLR	140000			; CLEAR THE LINK WORD
	MOV	R0,140002		; PUT # OF BLOCKS INTO SECOND WORD
	RETURN				; CONTROLLER IS READY

	.PAGE
	.SBTTL	KXUCB - UNIT ONLINE ENTRY POINT
;
; ** -	KXUCB - UNIT ONLINE ENTRY POINT
;
;	THE ONLY THING THAT THIS ROUTINE DOES IS TO SET UP K.OWN IN THE KRB
;
; INPUTS:
;
;	R3=CONTROLLER INDEX (S.KRB .NE. 0)
;	R4=ADDRESS OF SCB
;	R5=ADDRESS OF UCB
;	C = 1 TRANSITION TO OFF-LINE REQUESTED
;	C = 0 TRANSITION TO ON-LINE REQUESTED
;
; OUTPUTS:
;
;	K.OWN SET UP IN KRB
;
KXUCB::
	BCC	10$			;IF CC ONLINE REQUEST
	MOVB	#IE.DNR,$SCERR		;SET DEVICE NOT READY
	RETURN
10$:
	MOV	S.KRB(R4),R2		;RETRIEVE KRB ADDR
	MOV	R5,K.OWN(R2)		;MARK THIS UNIT AS OWNING THE CONTROLLER
	RETURN

	.PAGE
	.SBTTL	$KXINT - INTERRUPT SERVICE ROUTINE
;
; ** -	$KXINT - INTERRUPT SERVICE ROUTINE
;
;	WE CAN GET INTERRUPTED BY VMS FOR ONE OF TWO REASONS:
;
;	1) OUR SEND RING HAS TRANSITIONED FROM NOT EMPTY TO EMPTY
;
;	2) OUR RECEIVE RING HAS TRANSITIONED FROM EMPTY TO NOT EMPTY
;
;	WE CHECK BOTH CASES FOR EVERY INTERRUPT
;
;
	.ENABLE	LSB
CPRRCV:					;ENTRY POINT IF POOL BECOMES AVAILABLE
	SAVNR				;SAVE VOLATILE REGISTERS
	BR	5$			;CONTINUE IN COMMON
$KXINT::
	INTSV$	KX,PR5,1		;;;INTERRUPT SAVE MACRO
					;;;R5 = UCB ADDRESS
	MOV	U.SCB(R5),R4		;;;POINT TO CONTROLLER STATUS BLOCK
	TST	S.FRK+2(R4)		;;;FORK BLOCK IN USE?
	BEQ	2$			;;;IF EQ, NO, FORK THIS TIME
	RETURN				;;;RETURN

2$:	CALL	$FORK			;;;CREATE SYSTEM PROCESS
	CLR	S.FRK+2(R4)		;FREE FORK BLOCK FOR FURTHER INTERRUPTS
5$:	MOV	#140000,R3		;GET A BASE ADDRESS
	MOV	RNGBAS,@#KISAR6		;MAP THE RINGS
	MOV	RCVRNG,R2		;GET THE CURRENT RECEIVE RING BASE
	TST	(R2)			;DO WE HAVE A RECEIVE RING TO PROCESS?
	BPL	60$			;NO, ALL DONE.  SEE IF ANY PACKETS ARE
					;WAITING TO BE SENT.
;
; WE HAVE AN INPUT RING TO PROCESS
;
	MOV	R$ADDR(R2),@#KISAR6	;MAP THE HEADER IN APR6
	BIT	#HF$RSP,H$FLAG(R3)	;IS THIS A RESPONSE?
	BNE	10$			;YES, PROCESS IT
	CALL	VMSINI			;COMMANDS HAVE SEPARATE PROCESSING
	BR	20$			;CONTINUE IN COMMON
10$:	MOV	@#KISAR6,R0		;GET THE PACKET BIAS
	MOV	#$CPOUT,R1		;GET QUEUE LISTHEAD
	CALL	SENRSP			;SEND BACK THE RESPONSE
20$:	BCC	40$			;IF SUCCESS, CONTINUE
30$:	RETURN				;WE'LL BE CALLED LATER AT CPRRCV

40$:	MOV	RNGBAS,@#KISAR6		;REMAP THE RINGS
	CLR	@RCVRNG			;WE'RE DONE WITH THIS RING NOW
;
;INTERRUPT IF NECESSARY
;
	TST	@PRVRCV			;SHOULD WE INTERRUPT?
	BPL	50$			;NO, JUST CONTINUE
	BIT	#F5.NRT,$FMSK5		;IS THIS A REMOTE NETWORK SYSTEM?
	BNE	45$			;IF NE YES, DON'T DO KXJ SPECIFIC STUFF
	MOV	$KXVC1,@#KXJQIR		;INTERRUPT THE VAX
	BR	50$			;CONTINUE IN COMMON
45$:	MOV	$ACTHD,R0		;GET THE CPRNET TCB	
	BIC	#TS.STP,T.STAT(R0)	;UNSTOP
	BIC	#T2.STP*2!T2.STP,T.ST2(R0) ;CLEAR ALL STOP BITS
	CALL	$SETCR			;REQUEST SCHEDULING OF CPRNET
;
;NOW MOVE TO THE NEXT RING
;
50$:	MOV	RCVRNG,PRVRCV		;CURRENT RING IS NOW THE PREVIOUS RING
	ADD	#R$SIZE,RCVRNG		;MOVE POINTER TO NEXT RING
	CMP	RCVRNG,WRAPRC		;DO WE NEED TO WRAP?
	BNE	CPRRCV			;NOPE, GET NEXT RING
	MOV	FRSTRC,RCVRNG		;START AT THE BEGINNING
	BR	CPRRCV
;
; WE'RE DONE WITH THE RECEIVE RINGS.  SEE IF THERE ARE ANY SEND RINGS AVAILABLE
; AND IF SO IF THERE ARE ANY PACKETS QUEUED TO BE SENT
;
60$:	CLR	$CPPOL			;NO LONGER WAITING FOR POOL
	TST	@SNDRNG			;IS THERE ANOTHER RING AVAILABLE?
	BMI	80$			;NOPE, EXIT NOW
	MOV	$CPWAT,R1		;GET FIRST WAITING PACKET ADDRESS
	BEQ	80$			;NONE, JUST CONTINUE
	MOV	R1,@#KISAR6		;MAP THE PACKET
	MOV	H$LINK(R3),$CPWAT	;MOVE THE LINK DOWN
	BNE	70$			;IF NO OTHER PACKET...
	CLR	$CPWAT+2		;CLEAR BOTH WORDS OF QUEUE
70$:	MOVB	(R3),R4			;GET LENGTH
	ASH	#6,R4			; MAKE INTO BYTE LENGTH
	CLR	R0			;NO FLAGS
	CALL	SENPKT			;SEND THE PACKET
	BR	60$			;GO TRY FOR ANOTHER
80$:	RETURN
	.DSABL	LSB
	.PAGE
	.SBTTL SENRSP - RETURN RESPONSE PACKET
;
; THIS ROUTINE RETURNS THE RESPONSE PACKET TO IT'S ORIGIN.
;
; INPUTS:
;
;	R0	PACKET BIAS
;	R1	LISTHEAD OF QUEUE CONTAINING PACKET (USUALLY $CPOUT) OR 0
;		IF PACKET NOT QUEUED
;	R3	140000 (APR6 BASE)
;
;	PACKET MAPPED IN APR6
;
; OUTPUTS:
;
;	CARRY CLEAR IF SUCCESSFUL, CARRY SET IF NO POOL AVAILABLE FOR AST
;	RESPONSE RETURNED TO SENDER
;
SENRSP:
	MOV	R1,-(SP)		;SAVE THE QUEUE LISTHEAD
	BIT	#HF$UNB,H$FLAG(R3)	;SHOULD WE JUST UNBLOCK THE TASK?
	BEQ	10$			;YES, DON'T REMOVE FROM QUEUE
	CALL	160$			;UNBLOCK THE TASK
	BIC	#HF$UNB!HF$BLK,H$FLAG(R3) ;DON'T UNBLOCK NEXT TIME
	TST	(SP)+			;CLEAN STACK
	BR	150$			;AND EXIT
10$:
	BITB	#HF$AST,H$FLAG(R3)	;DO WE NEED TO QUEUE AN AST?
	BNE	50$			;YES, GO DO IT
;
; WE AREN'T QUEUEING AN AST.  THAT EITHER MEANS THAT WE ARE COMPLETING A
; DETACHED RETURN, OR WE ARE RETURNING TO AN EXEC ROUTINE.  A DETACHED RETURN
; WILL HAVE H$RET=0.  IF IT IS A DETACHED RETURN, UNBLOCK THE TASK IF NECESSARY,
; STORE THE TASK INDEX IF IT WAS A TASK INITIATION, AND DEALLOCATE THE BUFFER.
; IF IT IS AN EXEC RETURN, RETURN TO THE CALLING ROUTINE WITH:
;
;	R0	BUFFER ADDRESS

	CMPB	#HT$LST,H$TYPE(R3)	;IS THIS A LOST PACKET NOTIFICATION?
	BEQ	20$			;YES, DON'T UNBLOCK OR RESCHEDULE
	CALL	160$			;UNBLOCK THE TASK IF NECESSARY
20$:	MOV	(SP)+,R1		;GET LISTHEAD
	CALL	90$			;REMOVE FROM QUEUE
	MOV	H$BIAS(R3),-(SP)	;SAVE THE APR5 BIAS FOR CALL
	MOV	H$RET(R3),-(SP)		;AND ADDRESS
	BEQ	30$			;IF NONE, THIS IS A DETACHED RETURN
	CALL	$MPPRO			;CALL THE OTHER ROUTINE AS A COROUTINE
	BR	150$			;COMMON EXIT POINT
;
; DETACHED RETURN PROCESSING
;
30$:	CMP	(SP)+,(SP)+		;CLEAN THE STACK
	CMP	#HT$RUN,H$TYPE(R3)	;WAS THIS A TASK INITIATION?
	BNE	40$			;NO, JUST CONTINUE
	MOV	H$TCB(R3),R5		;GET THE TCB
	MOVB	P$TKI(R3),T.TKI(R5)	;SET UP THE TASK INDEX
40$:	MOV	@#KISAR6,R0		;GET THE ADDRESS OF THE PACKET
	CALL	CPRDEA			;DEALLOCATE THE HEADER
	BR	150$
;
;AST PROCESSING- ALLOCATE AN AST BLOCK, FILL IT IN, AND QUEUE IT TO THE TASK
;IF ALLOCATION FAILURE, RETURN WITH CARRY SET, WE WILL BE CALLED LATER AT CPRRCV
;
50$:	MOV	#12,R1			;GET THE SIZE OF OUR AST BLOCK
	CALL	$ALOCB			;GET IT
	BCC	60$			;WE GOT IT
	INC	$CPPOL			;WE NEED POOL LATER
	TST	(SP)+			;GET RID OF SAVED LISTHEAD
	SEC				;COULDN'T COMPLETE
	RETURN

60$:	MOV	R0,R2			;GET A COPY OF THE BLOCK ADDRESS
	TST	(R2)+			;SKIP THE LINK WORD
	MOV	#AK.GBI!100,(R2)+	;GENERAL BUFFERED I/O AST ENTRY POINT
	MOV	$KXBAS,(R2)+		;OUR MAPPING
	MOV	#CPRAST,(R2)+		;THE AST SERVICE ROUTINE ADDRESS
	MOV	@#KISAR6,(R2)		;GET THE ADDRESS OF THE BUFFER
;
; QUEUE THE AST.  CALL THE ROUTINE TO UNBLOCK THE TASK AND REQUEST SCHEDULING
;
	MOV	H$TCB(R3),R2		;GET TCB ADDRESS
	ADD	#T.ASTL,R2		;POINT TO AST LISTHEAD
	MOV	(R2),(R0)		;LINK PACKET TO FRONT OF LIST
	BNE	70$			;
	MOV	R0,2(R2)		;
70$:	MOV	R0,(R2)			;
	CALL	160$			;UNBLOCK THE TASK
;
; IF THIS TASK STARTED A P0 IMAGE, CLEAR THE BIT IN THE TCB
;
	CMPB	#HT$VMS,H$TYPE(R3)	;DID THIS START A P0 IMAGE?
	BNE	80$			;NO, CONTINUE
	MOV	H$TCB(R3),R5		;GET THE TCB
	BIC	#T4.P0,T.ST4(R5)	;CLEAR THE P0 IMAGE BIT
;
; SET UP TO REMOVE PACKET FROM QUEUE
;
80$:	MOV	(SP)+,R1		;GET THE LISTHEAD
	MOV	@#KISAR6,R0		;GET THE CURRENT PACKET ADDRESS
;
; REMOVE THE PACKET FROM THE QUEUE.  THIS IS CALLED AS A SUBROUTINE IN THE
; CASE OF DETACHED RETURNS AND EXEC RETURNS, BUT MUST BE CALLED LAST IN THE
; CASE WHERE AN AST MUST BE QUEUED IN CASE WE HAVE TO EXIT BECAUSE OF A POOL
; ALLOCATION FAILURE
;
90$:	TST	R1			;IS THERE A QUEUE ADDRESS?
	BEQ	150$			;NOPE, JUST EXIT
	CMP	R0,(R1)			;FIRST OUTSTANDING PACKET?
	BNE	100$			;NOPE, WE'LL HAVE TO KEEP LOOKING
	MOV	H$LINK(R3),(R1)		;FIX THE LINK
	BNE	150$			;EXIT
	CLR	2(R1)			;CLEAR THE LAST PACKET POINTER
	BR	150$			;CONTINUE, PACKET REMOVED FROM QUEUE
100$:	MOV	(R1),R2			;GET FIRST PACKET IN QUEUE
;
; SEARCH FOR THE PACKET
;
110$:
	MOV	R2,@#KISAR6		;MAP THE PACKET
	BNE	120$			;
	CRASH				;RESPONSE NOT IN QUEUE
120$:
	MOV	H$LINK(R3),R2		;GET THE NEXT PACKET
	CMP	R0,R2			;NEXT PACKET OURS?
	BNE	110$			;NOPE, GET NEXT ONE
;
; FOUND THE PACKET
;
130$:	MOV	@#KISAR6,R2		;GET LAST PACKET ADDRESS
	MOV	H$LINK(R3),@#KISAR6	;MAP OUR PACKET
	MOV	H$LINK(R3),-(SP)	;GET NEXT LINK
	MOV	R2,@#KISAR6		;REMAP LAST PACKET
	MOV	(SP)+,H$LINK(R3)	;FIX THE LINKS
	BNE	140$			;IF LINK WAS NON-ZERO, NOT LAST PACKET
	MOV	R2,2(R1)		;LISTHEAD POINTS TO NEW LAST PACKET
140$:	MOV	R0,@#KISAR6		;REMAP THIS RESPONSE PACKET
150$:	CLC				;OK EXIT
	RETURN
;
; UNBLOCK THE TASK IF HF$BLK SET.  THIS NEEDS TO BE A SUBROUTINE FOR THE SAME
; REASON THAT REMOVING IT FROM THE QUEUE DOES - IT SHOULDN'T BE DONE IF THERE'S
; A RESOURCE FAILURE ON THE AST BLOCK ALLOCATION.  IT IS SEPARATE FROM THE
; ROUTINE TO REMOVE AN ELEMENT FROM THE QUEUE BECAUSE IT IS ALSO CALLED IF
; HF$UNB IS SET AND ALL THAT NEEDS DOING IS UNBLOCKING OF THE TASK.  
;
160$:
	CMPB	#HT$TKN,H$TYPE(R3)	;IS THIS TASK TERMINATION?
	BEQ	180$			;IF EQ YES, DON'T RESCHEDULE TASK
	CMPB	#HT$REM,H$TYPE(R3)	;IS THIS TASK REMOVE?
	BEQ	180$			;IF EQ YES, DON'T RESCHEDULE TASK
	CMPB	#HT$DSB,H$TYPE(R3)	;DELETE SUBPROCESS?
	BEQ	180$			;YES, DON'T SCHEDULE
	MOV	H$TCB(R3),R0		;GET THE TCB
	BIT	#HF$BLK,H$FLAG(R3)	;WAS THE TASK BLOCKED?
	BEQ	170$			;NO, JUST RETURN
	BIC	#TS.RSW,T.STAT(R0)	;UNBLOCK
170$:	BIC	#TS.RDN,T.STAT(R0)	;TEMPORARY HACK
	CALL	$SETCR			;SCHEDULE IT
180$:	MOV	@#KISAR6,R0		;GET PACKET MAPPING BACK
	RETURN

	.PAGE
	.SBTTL	VMSINI - PROCESS VMS INITIATED COMMANDS
;
; WE HAVE A VMS INITIATED COMMAND.
;
; INPUTS:
;
;	R2	BASE OF CURRENT INPUT RING
;	R3	140000 (APR6 BASE)
;
;	PACKET MAPPED IN APR6
;
; OUTPUTS:
;
;	PACKET DISPATCHED
;	RESPONSE RING SENT IF APPROPRIATE
;	CARRY SET INDICATES FAILURE TO COMPLETE REQUEST - EITHER NO SEND RING
;	OR POOL ALLOCATION FAILURE ON ABORT REQUEST.
;
VMSINI:
;
; DISPATCH ACCORDING TO TYPE OF VMS INITIATED COMMAND
;
	CMPB	H$TYPE(R3),#HT$UCA	;UNSOL. CHARACTER AST?
	BNE	10$			;IF NE, NO
	JMP	130$			;GO PROCESS AST
10$:	CMPB	H$TYPE(R3),#HT$P0R	;P0 READ?
	BNE	20$			;IF NE NO
	JMP	210$			;GO PROCESS P0 READ
20$:	CMPB	H$TYPE(R3),#HT$P0W	;P0 WRITE?
	BNE	30$			;IF NE NO
	JMP	210$			;GO PROCESS P0 WRITE
30$:
	MOV	#IS.SUC,H$STAT(R3)	;ASSUME SUCCESS				
	BIS	#HF$RSP,H$FLAG(R3)	;MARK THAT THIS IS A RESPONSE
;
; NOW DISPATCH TO THE CORRECT ROUTINE
;
	CMPB	#HT$GRI,H$TYPE(R3)	;GET RSX INFORMATION?			
	BNE	40$			;IF NE NO				
	JMP	240$			;					
40$:	CMPB	#HT$CTC,H$TYPE(R3)	;CONTROL C NOTIFICATION?
	BNE	401$			;NOPE
	JMP	50$			;IF EQ YES
401$:	CMPB	#HT$ABA,H$TYPE(R3)	;ABORT ALL?
	BNE	402$			;NOPE
	JMP	80$			;DISPATCH TO ABORT ALL
402$:	CMPB	#HT$RSX,H$TYPE(R3)	;MCR COMMAND?
	BEQ	403$			;YES, CONTINUE
	JMP	70$			;NO, ERROR
403$:
;
; COMMAND IS A QUEUE COMMAND LINE REQUEST.  THE DDS STRING IS UPDATED IF IT 
; IS AN IMMEDIATE MODE COMMAND FROM VMS.
;
	BIT	#HF$DIR,H$FLAG(R3)	;DOES IT INCLUDE VMS DEFAULT DIR?
	BEQ	44$			;NO.  CONTINUE
	CLR	R5			;GET A REGISTER
	BISB	H$UNIT(R3),R5		;TI UNIT NUMBER
	ASL	R5			;MAKE INTO WORD OFFSET
	MOV	UNITBL(R5),R5		;GET UCB ADDRESS
	BEQ	70$			;IF NO UCB, CAN'T SEND
	MOV	#120000+P$BLEN+4,R2
	ADD	P$BLEN(R3),R2		;DIRECTORY STRING DISPLACEMENT IN APR5
	CLR	R0			;CLEAR TOP HALF OF R0
	MOVB	<20000-2>(R2),R0	;LENGTH OF DIRECTORY STRING
	MOV	KISAR6,R1		;MAP PACKET TO APR5
	CALL	$CRCTX			;CREATE DDS CONTEXT BLOCK
	BCS	70$			;FAILED TO CREATE DDS
	MOV	U.CTX(R5),R1		;OLD DDS CONTEXT BLOCK POINTER
	BEQ	41$			;DON'T DEALLOCATE IF NONE
	CALL	$DLCTX			;DEALLOCATE OLD CONTEXT BLOCK
41$:
	MOV	R3,U.CTX(R5)		;PUT NEW CTX POINTER IN UCB
	MOV	KISAR6,-(SP)		;SAVE MAPPING
	MOV	R3,KISAR6		;MAP CONTEXT BLOCK
	MOV	#C.DDS+140001,R0 	;POINT TO FIRST CHAR OF DDS
	MOV	R5,-(SP)		;SAVE UCB ADDRESS
	CALL	CNTB			;CONVERT DDS TO BINARY, IF POSSIBLE
	MOV	(SP)+,R5		;RESTORE UCB ADDRESS
	MOV	(SP)+,KISAR6		;RESTORE MAPPING
	BCC	42$			;IF CC, CONVERSION DONE
	MOV	U.LUIC(R5),U.UIC(R5) 	;SET DEFAULT UIC = PROTECTION UIC
	BR	43$
42$:	MOV	R1,U.UIC(R5)		;SET DEFAULT UIC = BINARY EQUIV OF DDS
43$:
	MOV	#140000,R3		;RESTORE APR6 BASE
44$:
	CLR	R1			;GET A CLEAN REGISTER
	BISB	P$BLEN(R3),R1		;GET THE LENGTH OF THE STRING BUFFER
	ADD	#C.CTXT+77,R1		;ADD FIXED AREA AND ROUND TO 32 WD BLOCK
	ASH	#-6,R1			;MAKE INTO A 32 WORD BLOCK ADDRESS
	CALL	$ALSEC			;GET SECONDARY POOL
	BCS	70$			;NO POOL, SEND BACK ERROR
;
; FILL IN FIELDS IN THE COMMAND BUFFER BLOCK
;
	CLR	R2			;GET A REGISTER
	BISB	H$UNIT(R3),R2		;GET UNIT NUMBER
	ASL	R2			;MAKE INTO WORD OFFSET
	TST	UNITBL(R2)		;IS THIS UNIT ONLINE?
	BEQ	70$			;IF EQ, NO
	MOV	R0,R3			;MOVE THE ADDRESS WHERE $BLXIO NEEDS IT
	MOV	#140000,R4		;APR 6 BIAS
	MOV	KISAR6,-(SP)		;SAVE THE CPR BLOCK MAPPING
	CLR	R0			;GET A CLEAN REGISTER
	BISB	P$BLEN(R4),R0		;LENGTH OF TRANSFER
	MOV	H$STAT+2(R4),-(SP)	;BOGUS FORCE MCR FLAG BIT
	MOV	H$FLAG(R4),-(SP)	;PACKET FLAGS WORD
	MOV	UNITBL(R2),-(SP)	;TI: UCB
	MOVB	140000+P$BLEN+1(R0),R2	;GET TERMINATOR CHARACTER
	MOV	R3,KISAR6		;MAP THE BLOCK
	TST	(R4)+			;MOVE THE POINTER UP TO C.CTCB
	MOV	$MCRPT,(R4)+		;QUEUE PACKET TO DISPATCHER
	MOV	(SP)+,(R4)+		;TI UCB
	MOV	R0,(R4)			;CHARACTER COUNT
	DEC	(R4)+			;THAT INCLUDED THE TERMINATOR CHARACTER
	CLR	(R4)+			;ASSUME NORMAL COMMAND
	BIT	#HF$EXP,(SP)+		;IS IT EXPLICIT?
	BEQ	45$			;NOT IF ZERO
	MOV	#CC.TTD,-2(R4)		;MAKE MCR THINK THIS IS FROM TTDRV
45$:	BIT	#1,(SP)+		;IS THIS FORCED TO MCR?
	BEQ	46$			;NOPE, LEAVE IT ALONE
	BIS	#CC.MCR,-2(R4)		;SEND IT TO MCR
46$:	CLR	(R4)+			;STARTING OFFSET
	MOVB	R2,(R4)+		;TERMINATOR CHARACTER
	MOVB	R1,(R4)+		;SIZE OF PACKET
;
; NOW MOVE THE STRING TO THE SECONDARY POOL BLOCK
;
	MOV	#120000+P$BLEN+2,R2	;APR 5 BIAS
	MOV	(SP),R1			;BIAS OF HEADER PACKET
	CALL	$BLXIO			;AND MOVE THE STRING
	MOV	R3,R1			;GET THE BIAS WHERE $QCPKT NEEDS IT
	MOV	(SP)+,KISAR6		;REMAP THE HEADER
	CALL	$QCPKT			;QUEUE THE PACKET TO THE CLI
	BR	60$			;COMMON CODE WITH ^C NOTIFICATION
;
; HT$CTC
;
; SEND THE ^C NOTIFICATION PACKET TO THE CLI
;
50$:	MOV	#CC.CTC!CC.CLI,R1	;^C NOTIFICATION
	CLR	R2			;GET A REGISTER
	BISB	H$UNIT(R3),R2		;TI UNIT
	ASL	R2			;MAKE INTO WORD OFFSET
	MOV	UNITBL(R2),R2		;TI: UCB
	BEQ	70$			;IF NONE, ERROR
	CALL	$QCNTP			;QUEUE CONTROL PACKET TO CLI
60$:	BCC	120$			;IF SUCCESS, CONTINUE
	BEQ	120$			;IF EQ, CLI WAS ACTIVE, SUCCESS
	MOV	#140000,R3		;RESTORE THE OFFSET TO PACKET
70$:	MOV	#IE.UPN,H$STAT(R3)	;NOTIFY VMS OF BAD STATUS
	BR	120$			;AND EXIT
;
; HT$ABA
;
; ABORT ALL TASKS FOR THIS TI, COMPLETING WITH ERROR ANY OUTSTANDING PACKETS
; AND DISABLING THEIR T.TKI SO THEY CAN'T SEND ANY MORE CPR REQUESTS.
;
80$:	CLR	R5			;GET A REGISTER
	BISB	H$UNIT(R3),R5		;TI UNIT
	ASL	R5			;MAKE INTO WORD OFFSET
	MOV	UNITBL(R5),R5		;GET TI: UCB
	BEQ	120$			;NO UCB ADDRESS
	MOV	$ACTHD,R1		;GET FIRST TASK IN ACTIVE LIST
	BEQ	120$			;IF NONE, EXIT
90$:	CMP	T.UCB(R1),R5		;THIS UCB?
	BNE	110$			;NO, TRY NEXT ONE
	MOV	#S.CTKN,R0		;QUIET ABORT
	MOV	R1,-(SP)		;SAVE TCB ADDRESS
	CALL	$ABTSK			;ABORT THE TASK
	MOV	(SP)+,R1		;RESTORE TCB ADDRESS
100$:	MOV	@#KISAR6,-(SP)		;SAVE THE ABORT PACKET
	CALL	CPRABO			;WRECK TASK INDEX AND CLEAN UP QUEUES
	MOV	(SP)+,@#KISAR6		;RESTORE ABORT MAPPING
110$:	MOV	T.ACTL(R1),R1		;GET NEXT TASK
	BNE	90$			;IF THERE, CHECK IT
;
; SEND THE RESPONSE PACKET
;
120$:	MOV	@#KISAR6,R1		;GET THE PACKET ADDRESS
	MOV	RCVRNG,R2		;GET RECEIVE RING ADDRESS
	MOV	#140000,R3		;RESTORE THE OFFSET TO PACKET
	MOV	RNGBAS,@#KISAR6		;MAP THE RINGS
	MOV	2(R2),R4		;GET THE PACKET LENGTH
	MOV	R1,@#KISAR6		;REMAP THE PACKET
	CALL	SENPKT			;SEND IT OFF
	CLC				;MAKE SURE WE SHOW SUCCESS
	RETURN
;
; UNSOLICITED CHARACTER AST PACKET
;
130$:
	MOV	H$TCB(R3),R0		;GET USER'S TCB ADDRESS
;
; GET THE CORRECT UCB ADDRESS
;
	BIT	#PF$NET,P$ASF(R3)	;IS THIS A NETWORK AST?
	BEQ	140$			;IF EQ NO

	MOV	XXNET,R5		;GET NETWORK UCB ADDRESS
	BNE	160$			;IF NE GOT IT
	MOV	#"NS,R4			;LOOK FOR IT
	CALL	GETUCB			;
	MOV	R5,XXNET		;STORE IT FOR LATER
	BR	160$
140$:
	BIT	#PF$TI,P$ASF(R3)	;IS AST FOR USER'S TI?
	BNE	150$			;IF NE YES
	MOV	XXUCB,R5		;GET GENERIC HT UCB ADDRESS
	BNE	160$			;IF NE GOT IT
	MOV	#"HT,R4			;LOOK FOR IT
	CALL	GETUCB			;
	MOV	R5,XXUCB		;STORE IT FOR LATER
	BR	160$
150$:
	MOV	T.UCB(R0),R5		;UCB IS USER'S TI:
160$:
;
; FIND AST CONTROL BLOCK
;
	ADD	#U.RAST,R5		;POINT TO LIST HEAD
	MOV	R5,R1			;GET ADDRESS OF LIST HEAD
170$:	MOV	R1,R4			;SAVE ADDRESS OF PREVIOUS
	MOV	(R4),R1			;GET NEXT ACB
	BEQ	200$			; IF ACB NOT FOUND, RETURN ERROR.
	CMP	A.PRM+14(R1),R0		;DOES TCB MATCH?
	BNE	170$			;IF NE NO
	CMPB	A.PRM+16(R1),P$LUN(R3)	;DO LUN NUMBERS MATCH?
	BNE	170$			;IF NE NO
;
; DEQUEUE AST CONTROL BLOCK
;
	MOV	(R1),(R4)		;TAKE IT OUT OF LIST
	BNE	180$			;IF NE NO NEW LAST
	MOV	R4,2(R5)		;POINT TO NEW LAST
180$:
;
; FILL IN AST CONTROL BLOCK
;
	MOV	KISAR6,A.PRM+12(R1)	;FILL IN HEADER BIAS FOR RESPONSE
	MOVB	P$APM(R3),A.PRM(R1)	;GET CHARACTER - NOTHING IF NETWORK
	MOV	A.PRM+10(R1),A.AST(R1)  ;ASSUME NO CONTROL C AST SPECIFIED
	TST	A.PRM+6(R1)		;WAS IT SPECIFIED? - NEVER FOR NETWORK
	BEQ	190$			;IF EQ NO
	CMPB	A.PRM(R1),#3		;IS THE CHARACTER A CONTROL C?
	BNE	190$			;IF NE NO
	MOV	A.PRM+6(R1),A.AST(R1)	;USE THIS AST ADDRESS INSTEAD
190$:
;
; QUEUE AST CONTROL BLOCK TO TCB
;
	CALL	$QASTT			;INSERT IT IN QUEUE AND RESCHEDULE
	CLC
	RETURN
200$:
	MOV	#IE.ABO,H$STAT(R3)	; THE TASK MUST BE GOING AWAY.
	MOV	@#KISAR6,R1		; TELL SENPKT WHERE PACKET IS.
	MOV	#H$SIZE+6,R4		; PASS LENGTH IN BYTES.
	CALL	SENPKT			; SEND THE RESPONSE.
	CLC
	RETURN
;
; P0 READ OR P0 WRITE REQUESTS
;
210$:
;
; ALLOCATE AN I/O PACKET
;
	MOV	#I.LGTH,R1		;GET LENGTH OF I/O PACKET
	CALL	$ALOCB			;ALLOCATE IT
	BCC	220$			;IF CC, OKAY
	RETURN				;RETURN WITH FAILURE
220$:
;
; FILL IN I/O PACKET FIELDS
;
	MOV	R0,R1			;GET PACKET ADDRESS IN R1
	CLR	I.PRI(R1)		;CLEAR PRIORITY FIELD AND EFN FIELD
	MOV	H$TCB(R3),I.TCB(R1)	;FILL IN TCB OF OFFSPRING TASK
	CLR	I.LN2(R1)		;NO LUN NUMBER, NEVER CHECKED IN VTDRV
	CLR	R5			;GET A REGISTER
	BISB	H$UNIT(R3),R5		;GET UNIT NUMBER
	ASL	R5			;MAKE INTO WORD OFFSET
	MOV	UNITBL(R5),R5		;GET UCB ADDRESS
	MOV	R5,I.UCB(R1)		;FILL IN UCB
	MOV	#IO.WLB,I.FCN(R1)	;ASSUME WRITE
	CMPB	H$TYPE(R3),#HT$P0W	;IS IT A WRITE?
	BEQ	230$			;IF EQ YES
	MOV	#IO.RLB,I.FCN(R1)	;FILL IN READ FUNCTION CODE
	CMPB	H$TYPE(R3),#HT$P0R	;IF IT A READ?
	BEQ	230$			;IF EQ YES
	MOV	#IO.WLB,I.FCN(R1)	;FILL IN WRITE FUNCTION CODE
230$:	MOV	KINAR5,I.IOSB+2(R1)	;FILL IN BIAS OF RETURN ROUTINE
	MOV	#P0CMPL!1,I.IOSB+4(R1) 	;FILL IN OFFSET OF RETURN ROUTINE
	CLR	I.AST(R1)		;NO AST ADDRESS
	MOV	KISAR6,I.PRM(R1)	;FILL IN BIAS OF BUFFER
	MOV	#H$SIZE+2+140000,I.PRM+2(R1) ;FILL IN OFFSET OF BUFFER
	MOV	H$SIZE(R3),I.PRM+4(R1)	;FILL IN LENGTH OF REQUEST
	MOV	H$STAT(R3),I.PRM+6(R1) 	;FILL IN 1ST WORD OF VFC
	MOV	H$STAT+2(R3),I.PRM+10(R1) ;FILL IN 2ND WORD
;
; CALL THE VT DRIVER
;
	MOV	U.SCB(R5),R4		;GET SCB ADDRESS
	CALL	$DRQRQ			;QUEUE THE PACKET TO THE DRVIER

	CLC
	RETURN
;										
; PROCESS GET RSX INFORMATION PACKET						
;										
240$:										
	MOV	#IS.SUC,H$STAT(R3)	;ASSUME SUCCESS				
	ADD	#H$SIZE,R3		;POINT TO ITEM LIST			
	CMPB	#II$LOF,I$ID(R3)	;IS THIS GET LOGGED OFF BIT ITEM?	
	BEQ	260$			;IF EQ OKAY				
250$:										
	SUB	#H$SIZE,R3		;POINT TO BEGINNING OF PACKET		
	MOV	#0,H$STAT(R3)		;INDICATE ERROR				
	BR	280$			;GO TO SEND PACKET BACK			
260$:										
	MOV	I$BUF(R3),R1		;GET UNIT NUMBER			
	MOV	#$DEVHD,R0		;GET ADDRESS OF FIRST DCB		
270$:	MOV	(R0),R0			;GET NEXT DCB				
	BEQ	250$			;IF EQ NOT FOUND, ERROR			
	CMP	#"HT,D.NAM(R0)		;IS THIS AN HT DCB			
	BNE	270$			;IF NE GET NEXT ONE			
	CMPB	#377,D.UNIT(R0)		;IS THIS THE GENERIC HT UCB?		
	BEQ	270$			;IF EQ, NOT IT				
	MUL	D.UCBL(R0),R1		;GET OFFSET OF UCB WE'RE LOOKING FOR	
	ADD	D.UCB(R0),R1		;GET ADDRESS OF UCB			
	MOVB	U.CW2+1(R1),I$BUF(R3) 	;GET LOGGED OFF BIT IN LOW BIT OF WORD	
280$:										
	MOV	@#KISAR6,R1		;GET PACKET ADDRESS			
	SUB	#H$SIZE,R3		;RESTORE R3
	MOV	#H$SIZE+4,R4		;GET SIZE OF PACKET			
	CALL	SENPKT			;SEND RESPONSE				
	CLC									
	RETURN									


;
;	CNTB - CONVERT A NAMED DIRECTORY TO A BINARY WORD IF
;		IN THE FORM OF [G,M] OR [GGGMMM]
;
;	INPUTS:  R0 = BUFFER POINTER
;
;	OUTPUTS:  IF CC, R1 = BINARY WORD
;		  IF CS, INDICATES NAMED DIRECTORY NOT CONVERTED
;

CNTB:
	CLR	-(SP)		; USE STACK FOR FLAG WORD
	MOV	#3,R4		; NUMBER OF CHARS TO CONVERT
	CLR	R1		; CLEAR ACCUMULATED VALUE
	MOVB	#',,R2		; STOP ON A COMMA
	CALL	100$		; CONVERT
	BCS	20$		; BR IF INVALID
	MOV	R1,R3		; STORE RESULT
	BEQ	20$		; IF EQ, INVALID
	MOV	#3,R4		; NUMBER OF CHARS TO CONVERT
	CLR	R1		; CLEAR ACCUMULATED VALUE
	CMPB	#',,(R0)	; POINTING TO A COMMA?
	BNE	10$		; IF NE, NO
	TSTB	(R0)+		; SKIP THE COMMA
	INC	(SP)		; INDICATE COMMA SEEN
10$:	MOVB	#'],R2		; STOP ON A BRACKET
	CALL	100$		; CONVERT
	BCS	20$		; BR IF INVALID
	SWAB	R3		; PUT GROUP CODE IN HIGH BYTE
	BIS	R3,R1		; PUT INTO RESULT
	BEQ	20$		; IF EQ, INVALID
	CMPB	#'],(R0)+	; ENDING BRACKET?
	BNE	20$		; IF NE, ERROR
	TST	(SP)		; DID WE SEE A COMMA?
	BNE	15$		; IF NE, YES
	TST	R4		; VERIFY WE PARSED 3 CHARS
	BNE	20$		; IF NE, - ERROR
15$:	TST	(SP)+		; CLEAN STACK, INDICATE SUCCESS
	BR	30$		; RETURN TO CALLER WITH CC
20$:	TST	(SP)+		; CLEAN STACK
	SEC			; INDICATE DIRECTORY NOT CONVERTED
30$:	RETURN			; AND RETURN TO CALLER


100$:	MOVB	(R0)+,R5	; GET NEXT CHAR
	CMPB	R2,R5		; IS THIS ENDING CHARACTER?
	BEQ	115$		; BR IF YES
	SUB	#'0,R5		; SUBTRACT CHARACTER BIAS
	BMI	120$		; IF MI, ILLEGAL CHAR
	CMPB	R5,#8.		; CHECK AGAINST BASE
	BHIS	120$		; IF HIS, ILLEGAL CHAR
	MUL	#8.,R1		; MULT RESULT BY BASE
	ADD	R5,R1		; ACCUMULATE RESULT
	SOB	R4,100$		; GO AGAIN
110$:	CMP	#377,R1		; NUMBER GREATER THAN 377?
	RETURN			; RETURN TO ABOVE
115$:	TSTB	-(R0)		; BACK UP
	CMP	#3,R4		; DID WE PARSE ANYTHING?
	BNE	110$		; IF NE, YES - OK
120$:	SEC			; INVALID CHARACTER TO CONVERT
	RETURN			; RETURN TO ABOVE


	.PAGE
;
; P0CMPL - COMPLETION ROUTINE FOR P0 READ AND P0 WRITE
;
; INPUT -
;		R3 - ADDRESS OF I/O PACKET
;
P0CMPL:
   	MOV	R3,-(SP)		;SAVE I/O PACKET ADDRESS
	MOV	KISAR6,-(SP)		;SAVE MAPPING
	MOV	I.PRM(R3),KISAR6	;MAP PACKET
	MOV	I.PRM+6(R3),140000+H$STAT ;SET STATUS
	MOV	I.PRM+10(R3),140000+H$STAT+2 ;
	CLR	R0			;GET LENGTH
	MOVB	140000,R0		;
	ASH	#6,R0			;
	CPSEN$	#SN$RSP,KISAR6,R0	;SEND RESPONSE
	MOV	(SP)+,KISAR6		;RESTORE MAPPING
   	MOV	(SP)+,R0		;RESTORE I/O PACKET ADDRESS
   	MOV	#I.LGTH,R1		;LENGTH OF PACKET
   	JMP	$DEACB			;DEALLOCATE AND RETURN
;
; GETUCB - FIND GENERIC UCB ADDRESS
;
; INPUT - R4 ASCII FOR DEVICE NAME
;
; OUTPUT - R5 UCB ADDRESS
;
GETUCB:
	MOV	#$DEVHD,R5		;GET LIST HEAD
10$:	MOV	(R5),R5			;GET NEXT DCB
	CMP	R4,D.NAM(R5)		;IS THIS IT?
	BNE	10$			;IF NE NO
	CMPB	#377,D.UNIT(R5) 	;IS IT THE GENERIC ONE?
	BNE	10$			;IF NE NO
	MOV	D.UCB(R5),R5		;GET UCB
	RETURN				;DONE

	.PAGE
	.SBTTL	CPRABO - ABORT TASK AND CLEAN UP QUEUES
;
; CPRABO
;
; WRECK TASK INDEX SO THIS TASK CANNOT ISSUE FURTHER REQUESTS, AND COMPLETE
; ANY PACKETS LEFT IN THE OUTSTANDING OR WAIT QUEUES.
;
; INPUTS:
;
;	R1	TCB OF TASK BEING ABORTED
;
; OUTPUTS:
;
;	ALL PACKETS IN QUEUES ARE RETURNED
;	TASK INDEX IS SET TO -1
;	R1 AND R5 REGISTERS PRESERVED
;
CPRABO:
	MOV	R5,-(SP)		;SAVE R5
	MOV	R1,-(SP)		;SAVE TCB ADDRESS
	MOV	#140000,R3		;GET APR6 BASE
	MOV	R1,R2			;MOVE THE TCB
	CMPB	T.TKI(R2),$RMTSK	;IS THIS A REMOTE PERMANENT TASK?
	BLOS	10$			;IF LOS, YES, DON'T TRASH INDEX
	MOVB	#-1,T.TKI(R2)		;FIX THE TASK INDEX
10$:	MOV	#2,R4			;WE NEED TO CHECK TWO QUEUES
	MOV	#$CPOUT,R1		;GET QUEUE LISTHEAD
20$:	MOV	(R1),@#KISAR6		;MAP OUTSTANDING PACKET
	BEQ	50$			;NONE
30$:	CMP	H$TCB(R3),R2		;PACKET FOR THIS TCB?
	BNE	40$			;NOPE, TRY NEXT ONE
	CLR	R0			;GET A REGISTER
	BISB	H$UNIT(R3),R0		;GET THE UNIT NUMBER
	ASL	R0			;MAKE INTO WORD OFFSET
	MOV	UNITBL(R0),R0		;GET THE UCB ADDRESS
	CMP	T.UCB(R2),R0		;CORRECT UCB? (MIGHT NOT BE IF MCR)
	BNE	40$			;NOPE, TRY NEXT ONE
	BITB	#HT$SYS,H$TYPE(R3)	;IS THIS PKT FOR CPRSYS?
	BNE	40$			;YES, DON'T COMPLETE THE PACKET NOW
					;...CPRSYS IS STILL RUNNING
;
; COMPLETE THE PACKET WITH ERROR STATUS
;
	MOV	@#KISAR6,R0		;GET PACKET ADDRESS
	MOV	#IE.PRI,H$STAT(R3)	;SET ABORT STATUS
	MOV	R1,-(SP)		;SAVE LISTHEAD,
	MOV	R4,-(SP)		; COUNT,
	MOV	R0,-(SP)		; AND PACKET MAPPING
	CALL	SENRSP			;SEND THE RESPONSE
	MOV	(SP)+,@#KISAR6		;RESTORE PACKET MAPPING,
	MOV	(SP)+,R4		; COUNT,
	MOV	(SP)+,R1		; AND LISTHEAD
	MOV	(SP),R2			;RESTORE TCB
	MOV	#140000,R3		;RESTORE APR6 BASE
	BCS	70$			;IF FAILURE, RETURN
40$:	MOV	H$LINK(R3),@#KISAR6	;GET NEXT PACKET
	BNE	30$			;ANOTHER ONE, CHECK IT
50$:	MOV	#$CPWAT,R1		;MAP FIRST WAITING PACKET
	SOB	R4,20$			;DO BOTH QUEUES
60$:	CLC
70$:	MOV	(SP)+,R1		;RESTORE TCB
	MOV	(SP)+,R5		;RESTORE R5
	RETURN

	.PAGE
	.SBTTL	CPRAST - KERNAL AST SERVICE ROUTINE
;
; ** -  CPRAST - KERNAL AST SERVICE ROUTINE
;
;	THIS ROUTINE RETURNS CONTROL TO THE TASK OR DIRECTIVE ROUTINE WITH THE
;	FOLLOWING REGISTER CONTENTS:
;
;	R0	ADDRESS OF BUFFER - TO BE USED IN AN APR
;
;	INPUTS:
;
;	R3 	ADDRESS OF AST BLOCK
;
;	CONTROL IS TRANSFERED TO THE TASK COMPLETION ROUTINE USING THE ROUTINE
;	$MPPRO.  THIS ROUTINE EXPECTS THE INPUTS:
;
;	 (SP)	RETURN ADDRESS
;	2(SP)	ROUTINE ADDRESS TO CALL
;	4(SP)	APR5 BIAS OF ROUTINE
;
;	BY PUTTING THE APR BIASES AND THE CALLING ADDRESS UNDER THE RETURN
;	ADDRESS THAT IS CURRENTLY ON THE STACK, WE CAN JUMP TO THE TASK
;	COMPLETION ROUTINE RATHER THAN CALL IT.

CPRAST::
	MOV	R3,R0			;SAVE THE AST BLOCK ADDRESS
	MOV	10(R3),-(SP)		;SAVE THE BUFFER ADDRESS
	MOV	#12,R1			;SIZE OF AST BLOCK
	CALL	$DEACB			;DEALLOCATE IT
	MOV	(SP)+,R0		;BUFFER ADDRESS,
	MOV	R0,@#KISAR6		;MAP THE BUFFER
	MOV	#140000,R1		;GET A BASE ADDRESS
	MOV	H$RET(R1),-(SP)		;SET UP THE ROUTINE ADDRESS
	MOV	2(SP),-(SP)		;MOVE THE RETURN ADDRESS
	MOV	H$BIAS(R1),4(SP)	;PUT IN THE APR BIAS
	BEQ	20$			;NO BIAS, GET THE MAPPING FROM USER APRS
	BIT	#HF$DSW,H$FLAG(R1)	;SHOULD WE SET THE DSW?
	BEQ	30$			;NOPE, JUST CALL THE ROUTINE
	BIC	#1,$UMPS		;BE OPTIMISTIC; ASSUME SUCCESS
	MOV	H$STAT(R1),-(SP)	;PUT THE STATUS ON THE STACK
	BPL	10$			;IF SUCCESS, LEAVE CARRY ALONE
	BIS	#1,$UMPS		;SET USER'S CARRY
10$:
	MTPD$	@#H.DSW			;SET DIRECTIVE STATUS WORD
	BR	30$

20$:	MOV	@#UINAR5,4(SP)		;GET MAPPING FROM USER TASK
	MOV	@#UISAR6,@#KISAR6	;MAP APR6 TOO
	MOV	@#UINAR6,@#KINAR6	;I&D

30$:	JMP	$MPPRO			;AND GO BACK TO THE TASK
	.PAGE
	.SBTTL	CPRCON - CONNECT TI: UCB TO VMS CP: UCB
;
;	CPRCON - CONNECT TI: UCB TO VMS CP: UCB
;
;	THIS ROUTINE IS CALLED BY THE $$DRV UNIT ONLINE ENTRY POINT FOR EACH TI:
;	UCB.  IF CARRY IS CLEAR, THIS IS AN ONLINE REQUEST, PUT THE UCB ADDRESS
;	INTO OUR UCB TABLE AT THE CORRECT ADDRESS AND PUT THE UNIT NUMBER AT
;	U.CPUN.  NOTE THAT THIS UNIT NUMBER IS THE UNIT NUMBER OF THE VMS CP: 
;	UNIT, AND THOUGH IT MATCHES U.UNIT FOR HT: DEVICES, IT IS DIFFERENT FOR
;	VT: UNITS.
;
;	IF CARRY IS SET, THIS IS AN OFFLINE REQUEST, CLEAR THE UNIT OUT OF THE
;	UCB TABLE
;
;
;	INPUTS:
;
;	R5	TI: UCB ADDRESS
;
;	OUTPUTS:
;
;	ALL REGISTERS PRESERVED.
;	UCB TABLE UPDATED.
;	U.CPUN FILLED IN FOR ONLINE REQUESTS
;

CPRCON:
	BCS	30$			;OFFLINE REQUEST
	SAVNR				;SAVE R4 AND R5
	MOV	R3,-(SP)		;GET ONE MORE REGISTER
	CLR	R3			;CLEAR AND BIS SO NO SIGN EXTEND
	BISB	U.UNIT(R5),R3		;GET THE UNIT NUMBER
	MOV	U.DCB(R5),R4		;GET DCB ADDRESS
	CMP	D.NAM(R4),#"VT		;IS THIS A VT TERMINAL?
	BNE	10$			;IF NE NO
	ADD	$RMTTT,R3		;SKIP OVER HT TERMAINALS
	DEC	R3			;VT1: IS FIRST
10$:
	MOVB	R3,U.CPUN(R5)		;SET THE CP: UNIT
	ASL	R3			;MAKE INTO WORD OFFSET
	MOV	R5,UNITBL(R3)		;SET UCB IN UNIT TABLE
	MOV	(SP)+,R3		;RESTORE R3

	MOV	TOPRSX,R4		;GET THE TOP OF RSX SPACE
	SUB	U.CPKT(R5),R4		;GET THE PACKET
	CMP	R4,MAXBUF		;IS IT LESS THAN CURRENT MAX?
	BGE	20$			;NOPE, EXIT
	MOV	R4,MAXBUF		;NEW MAXIMUM SIZE
20$:	RETURN

30$:
	SAVNR				;SAVE R4 AND R5
	CLR	R4			;CLEAR AND USE BIS SO NO SIGN EXTEND
	BISB	U.CPUN(R5),R4		;GET THE CP: UNIT
	ASL	R4			;MAKE INTO WORD OFFSET
	CLR	UNITBL(R4)		;CLEAR OUT UCB IN UNIT TABLE
	RETURN

	.PAGE
	.SBTTL	CPRALO - BUFFER ALLOCATION ROUTINE
;
;	CPRALO - BUFFER ALLOCATION ROUTINE
;
;	THIS ROUTINE IS USED TO ALLOCATE RESOURCES TO SEND DATA FROM THE RSX
;	SYSTEM TO THE VMS SYSTEM.  IF THE RESOURCES ARE NOT AVAILABLE, THE
;	ROUTINE CHECKS THE FLAGS IN R0 TO DETERMINE WHAT ACTION TO TAKE.  IF
;	AL$XXD IS SET, THE REQUEST IS FROM THE XX DRIVER.  IN THIS CASE, THE
;	ROUTINE SAVES THE CONTEXT OF THE DRIVER TO RETURN WHEN RESOURCES ARE
;	AVAILABLE.  IF AL$XXD IS NOT SET, THE TASK IS BLOCKED PENDING RESOURCE
;	AVAILABILITY.  IF AL$BCK IS SET, THEN THE TASK'S PC IS BACKED UP OVER
;	THE EMT INSTRUCTION SO THAT WHEN IT IS RESCHEDULED IT WILL REENTER
;	SYSTEM STATE.  IF AL$BCK IS NOT SET, THE ROUTINE RETURNS WITH CARRY SET.
;
;	IF RESOURCES ARE AVAILABLE, THE BUFFER SPACE IS ALLOCATED.  IF THE FLAG
;	AL$IMP IS SET, AND THE TASK INDEX IN THE TCB IS NOT FILLED IN, AN
;	IMPLICIT TASK START REQUEST IS ISSUED.  CPRALO WILL RETURN AS IF A
;	RESOURCE WAS UNAVAILABLE, CAUSING THE TASK TO RESCHEDULE AND CALL THIS
;	ROUTINE AGAIN.  THIS ROUTINE IS CALLED FROM $CPALO IN THE EXEC.  ;
;	INPUTS:
;
;	R0	OPERATION FLAGS:
;		AL$BCK - BACK UP PC IF ALLOCATION FAILURE
;		AL$IMP - DO IMPLICIT TASK START IF NO TASK INDEX
;		AL$NBL - DON'T BLOCK TASK IF FAILURE
;		AL$XXD - REQUEST IS FROM THE XX DRIVER
;		AL$NVR - (DIRECTIVES) - RETURN C SET IF BUFFER > CPRBUF
;	R1	LENGTH OF BUFFER NECESSARY (IN 32 WORD BLOCKS)
;
;	OUTPUTS:
;
;	R0	ADDRESS OF BUFFER ALLOCATED - TO BE USED IN AN APR
;	R1	ACTUAL LENGTH ALLOCATED
;
;	THE LENGTH IS ALSO STORED IN THE FIRST BYTE OF THE BUFFER
;
CPRALO:
	SAVNR				;SAVE R4 AND R5
	SEC				;ASSUME FAILURE
	TST	R1			;IS THERE A LENGTH?
	BEQ	20$			;NOPE, JUST EXIT
	CMP	R1,MAXBUF		;WILL THIS EVER WORK?
	BGT	NEVER			;NOPE, GET OUT	
	MOV	@#KISAR6,-(SP)		;SAVE CURRENT APR6 MAPPING
	MOV	R0,-(SP)		;SAVE THE FLAG WORD
	MOV	#$CPRBF,R2		;SET UP THE POOL LISTHEAD
	BIT	#AL$IMP,R0		;DO IMPLICIT TASK START?
	BEQ	10$			;NO, JUST ALLOCATE THE BUFFER
	MOV	$TKTCB,R5		;GET THE TCB
	TSTB	T.TKI(R5)		;IS THERE A TASK INDEX?
	BEQ	IMPST			;NO, WE HAVE TO DO THE IMPLICIT START
10$:	CALL	$ALSC1			;ALLOCATE A BLOCK OF POOL
	BCS	NOPOOL			;NO POOL
	TST	(SP)+			;WE SUCCEEDED, SO DUMP FAILURE FLAG
	MOV	R0,@#KISAR6		;MAP THE BLOCK
	MOVB	R1,140000		;PUT IN THE LENGTH
	MOV	(SP)+,@#KISAR6		;RESTORE APR6 MAPPING
20$:	RETURN

	.PAGE
	.SBTTL	CPR BUFFER ALLOCATION FAILURE ROUTINES
;
; THIS ROUTINE IS CALLED WHEN THE ALLOCATION REQUESTED IS LARGER THAN THE 
; LARGEST AVAILABLE CPRBUF SEGMENT, AND THUS WILL NEVER SUCCEED.  IF THE
; DIRECTIVE THINKS THIS MIGHT HAPPEN, IT SETS AL$NVR IN THE FLAGS WORD.
; (CURRENTLY ONLY RMS 21.5 ELP DOES).  RETURN WITH CARRY SET
;
NEVER:
	BIT	#AL$NVR,R0		;SHOULD WE TELL THEM IT WILL NEVER WORK?
	BEQ	NOPOOL			;NO, THEY DIDN'T ASK
	SEC				;TELL THEM THE BAD NEWS
	RETURN
;
; THIS ROUTINE IS CALLED WHEN CPRALO FAILS TO ALLOCATE A RESOURCE.  SEE THE
; COMMENTS AT THE BEGINNING OF CPRALO FOR A DESCRIPTION OF THE ACTIONS TAKEN.
;
;
NOPOOL:	MOV	(SP)+,R0		;RESTORE FLAG FOR FAILURE
	MOV	(SP)+,@#KISAR6		;RESTORE APR6 MAPPING
	MOV	#T4.LBW,R1		;THE TASK IS BLOCKED FOR BUFFER WAIT

					;FALL THROUGH TO ALFAIL
ALFAIL:
;
; FIRST CHECK TO SEE IF THIS IS FROM XXDRV, WHICH IS HANDLED SPECIALLY
;
	BIT	#AL$XXD,R0		;IS THIS REQUEST FROM XXDRV?
	BEQ	10$			;NO, GO BLOCK IT NORMALLY
	INC	XXWAIT			;MARK A FAILURE
	MOV	R5,XXR5			;SAVE THE UCB ADDRESS
	ADD	#16,SP			;SKIP THE XXDRV RETURN
	RETURN				;AND EXIT

10$:	BIT	#AL$NBL,R0		;NO BLOCKING?
	BEQ	20$			;NO, BLOCK IT
	SEC				;SHO ERROR
	RETURN				;IF WE'RE NOT BLOCKING IT, WE DON'T
					;WANT TO BACK UP THE PC OR RESCHEDULE,
					;EITHER
20$:
;
; SET THE BLOCKING BITS, INCREMENT BLOCKING COUNTS, BACK UP THE PC IF NECESSARY,
; AND REQUEST RESCHEDULING
;
	MOV	$TKTCB,R5		;GET THE TCB
	BIS	#TS.RSW,T.STAT(R5)	;SET THE BLOCKING BIT
	TST	R1			;ANY WAIT FLAG?
	BEQ	30$			;NO, JUST EXIT
	BIS	R1,T.ST4(R5)		;BIT TO TELL WHY TASK IS BLOCKED
	INC	BUFFWT			;INCREMENT BUFFER WAIT COUNT
30$:	BIT	#AL$BCK,R0		;SHOULD WE BACK UP THE PC?
	BNE	40$			;IF NE, YES
	CALL	$DRWSE			;SCHEDULE ANOTHER TASK
	SEC
	RETURN
40$:
	SUB	#2,$UMPC		;BACK UP USER'S PC
	MOV	#$STACK-22,SP		;ALLOCATE?  WHAT ALLOCATE?
	JMP	$DRWSE

	.PAGE
	.SBTTL	IMPST - IMPLICIT TASK START
;
; THIS ROUTINE IS CALLED FROM CPRALO WHEN A TCB IS DETECTED WITH NO TASK INDEX.
; IN THIS CASE, THE TASK START PACKET IS CREATED AND SENT, AND CPRALO THEN
; BLOCKS THE TASK AND RETURNS AS IF THERE WERE AN ALLOCATION FAILURE.  THE
; PACKET IS SENT AS A PSEUDO REQUEST, AND THE DETACHED RETURN PROCESSING IN
; KXINT FILLS IN THE TASK INDEX AND UNBLOCKS THE TASK.
;
; THE IMPLICIT START REQUEST PACKET HAS THE PARAMETERS:
;		+------------+------------+
;		|         TASK UIC        |
;		+------------+------------+
;		|DEF DIR LEN | # OF LUNS  |
;		+------------+------------+
;		| DEFAULT DIRECTORY STRING|
;		|			  |
;
IMPST:
;
;	FIRST FIGURE OUT HOW BIG OF A BLOCK TO ALLOCATE
;
	MOV	#H$SIZE+4+77,R1		;SIZE IN BYTES OF FIXED AREA+77
	CLR	R4			;SET UP FOR NO CONTEXT BLOCK
	MOV	T.CTX(R5),@#KISAR6	;MAP THE CONTEXT BLOCK
	BEQ	10$			;IF EQ, THERE IS NO CONTEXT BLOCK
	MOV	#140000,R4		;GET A BASE ADDRESS IN R4
	MOVB	C.DDSL(R4),R4		;GET THE LENGTH
	ADD	R4,R1			;ADD SIZE OF DEFAULT STRING
10$:	ASH	#-6,R1			;MAKE INTO A 32 WORD BLOCK ADDRESS
	CALL	$ALSC1			;GET A BUFFER
	BCS	NOPOOL			;ALLOCATION FAILED
;
;	NOW FILL IN THE BLOCK
;
	MOV	R0,R3			;WE'LL NEED THE BIAS IN R3 FOR $BLXIO
	MOV	R4,R0			;AND WE'LL NEED THE LENGTH IN R0
	MOV	T.PCB(R5),R2		;GET THE PCB
	MOV	P.HDR(R2),R4		;GET HEADER ADDRESS
	BNE	20$			;IF EQ, EXTERNAL HEADER
	MOV	P.REL(R2),@#KISAR6	;MAP IT IN APR6
	MOV	#140000,R4		;GET ADDRESS IN R4
20$:	MOVB	H.NLUN(R4),-(SP)	;GET NUMBER OF LUNS
	MOV	H.CUIC(R4),-(SP)	;GET TASK PROTECTION UIC
	MOV	T.UCB(R5),R4		;ADDRESS OF TCB
	CMP	U.LUIC(R4),(SP)		;TERMINAL PROTECTION EQUAL TASK?
	BNE	25$			;NO.  SEND TASK PROTECTION TO CPR
	CLR	(SP)			;YES.  FLAG FOR CPR TO USE VMS UIC
25$:
	MOV	U.UIC(R4),-(SP)		;Terminal default UIC
	MOV	R3,@#KISAR6		;MAP THE COMMAND HEADER
	MOV	#140000,R4		;GET PACKET BASE ADDRESS
	MOVB	R1,(R4)			;SET THE PACKET SIZE
	MOVB	#HT$RUN,H$TYPE(R4)	;SET THE TYPE
	CLRB	H$ICNT(R4)		;CLEAR THE ITEM COUNT
	ADD	#P$UIC,R4		;START OF PARAMETER AREA
;
; If we are in nonamed mode, include the terminal's default UIC after the DDS.
; We always put the default UIC at offset 6 in the packet.  If we are in nonamed
; mode, it will follow the DDS ("[]").  If we are in named mode, we don't care
; about it, and in fact it will be overwritten by the DDS.
;
	MOV	(SP)+,6(R4)		;Default UIC goes after "[]"
	MOV	(SP)+,(R4)+		;Protection UIC
	MOVB	(SP)+,(R4)+		;NUMBER OF LUNS
	MOVB	R0,(R4)+		;SIZE OF DEFAULT STRING
	MOV	T.CTX(R5),R1		;CONTEXT BLOCK BIAS
	BEQ	30$			;IF EQ, NO CONTEXT BLOCK
	MOV	#120000+C.DDS,R2	;DEFAULT STRING DISPLACEMENT
	MOV	R0,-(SP)		;SAVE SIZE OF DEFAULT STRING
	CALL	$BLXIO			;MOVE THE DEFAULT STRING
	MOV	(SP)+,R0		;RESTORE SIZE OF DEFAULT STRING
	CMP	R0,#2			;Are we in nonamed mode (DDS = "[]")?
	BNE	30$			;If NE, no, continue
	ADD	R0,R0			;Else, include default UIC in packet length
30$:	ADD	#H$SIZE+4,R0		;GET THE TOTAL LENGTH
	MOV	R3,R2			;CAN'T PASS A PARAMETER IN R3

	CPSEN$	#SN$PSR,R2,R0

	MOV	(SP)+,R0		;GET BACK FLAG WORD
	MOV	(SP)+,@#KISAR6		;RESTORE APR6 MAPPING
	CLR	R1			;NOT WAITING ON A BUFFER
	BR	ALFAIL			;EXIT

	.PAGE
	.SBTTL	CPRDEA  -  DEALLOCATE BUFFER SPACE
;
; ** -	CPRDEA - DEALLOCATE BUFFER SPACE
;
;	THIS ROUTINE DEALLOCATES AND RETURNS TO THE CPR POOL A BUFFER BLOCK
;
;	INPUTS:
;
;	R0	ADDRESS OF BLOCK TO BE DEALLOCATED
;
;	THE FIRST BYTE OF THE BLOCK IS THE LENGTH IN 32 WORD BLOCKS
;
;	THE CORE BLOCK IS MERGED INTO THE FREE CORE CHAIN BY ADDRESS
;	AND MERGED WITH ANY BORDERING BLOCKS IF POSSIBLE
;
; R3, R4, R5 PRESERVED
;
CPRDEA:
	MOV	@#KISAR6,-(SP)		;SAVE APR6 MAPPING
	MOV	R0,@#KISAR6		;MAP THE BLOCK
	MOVB	140000,R1		;GET THE LENGTH
	MOV	(SP)+,@#KISAR6		;RESTORE MAPPING
	MOV	#$CPRBF,R2		;SET UP POOL LISTHEAD
	CALL	$DESC1			;DEALLOCATE THE POOL BLOCK AND RETURN
;
; FIRST CHECK IF ANY TASKS ARE WAITING FOR BUFFER SPACE. IF THEY ARE, SEARCH
; THE ACTIVE TASK LIST, CLEARING THE BIT WHEN FOUND UNTIL THE COUNT GOES TO 0.
; ON THE FIRST TASK FOUND WAITING (WHICH WILL BE THE HIGHEST PRIORITY), CALL
; $SETCR TO SCHEDULE THE TASK
;

10$:	TST	BUFFWT			;ANY TASKS WAITING FOR A BUFFER?
	BEQ	60$			;NO, CHECK XXDRV
	CLR	-(SP)			;FLAG TO TELL IF $SETCR HAS BEEN CALLED
	MOV	$ACTHD,R0		;GET THE FIRST ACTIVE TASK
20$:	BIT	#T4.LBW,T.ST4(R0)	;THIS TASK WAITING?
	BEQ	40$			;NO, TRY THE NEXT ONE
	BIC	#T4.LBW,T.ST4(R0)	;CLEAR THE WAITING BIT
	BIC	#TS.RSW,T.STAT(R0)	;AND THE BLOCKING BIT
	TST	(SP)			;HAVE WE CALLED $SETCR YET?
	BNE	30$			;YES, DON'T CALL IT AGAIN
	CALL	$SETCR			;CALL FOR A RESCHEDULE
	INC	(SP)			;MARK THAT WE DID THIS
30$:	DEC	BUFFWT			;DECREMENT THE COUNT
	BEQ	50$			;IF IT'S ZERO, EXIT

40$:	MOV	T.ACTL(R0),R0		;GET THE NEXT ACTIVE TASK
	BR	20$			;AND GO CHECK AGAIN

50$:	TST	(SP)+			;POP THE FLAG OFF THE STACK
60$:	TST	XXWAIT			;WAS XXDRV WAITING FOR BUFFER SPACE?
	BEQ	70$			;IF EQ NO, JUST EXIT
	CLR	XXWAIT			;CLEAR THE BUFFER WAIT
	CMP	XXBIAS,4(SP)		;WAS THIS A CPDEA CALL FROM XXDRV?
	BNE	80$			;NO, GO CALL XXDRV
70$:	RETURN				;CALL WAS FROM XXDRV, JUST RETURN TO
					;AVOID MULTIPLE CALL NESTING
;
; SET UP AND JUMP TO THE XXDRIVER
;
80$:	MOV	(SP),R5			;GET THE CURRENT RETURN ADDRESS
	MOV	XXBIAS,(SP)		;SET UP THE BIAS FOR $MPPRO
	MOV	XXALRT,-(SP)		;AND THE RETURN ADDRESS
	MOV	R5,-(SP)		;MOVE ORIGINAL RETURN ADDRESS FOR $MPPRO
	MOV	XXR5,R5			;RESTORE R5
	JMP	$MPPRO			;CALL THE DRIVER

	.PAGE
	.SBTTL	CPRSEN	-  SEND RING ENTRY TO VMS
;
; ** -	CPRSEN - SEND RING ENTRY TO VMS
;
;	THIS ROUTINE FILLS IN COMMON FIELDS IN THE HEADER AND THEN SENDS THE
;	FILLED-IN HEADER-ITEM BUFFER TO VMS.  
;
;	THE BITS IN THE OPCODE FIELD DETERMINE THE FOLLOWING ACTIONS:
;
;	BIT		ACTION
;
;	SF$BLK		THE TASK IS BLOCKED PENDING REQUEST COMPLETION
;	SF$BIA		THE BIAS OF THE CALLING ROUTINE IS SAVED IN THE HEADER
;	SF$HDR		COMMON FIELDS ARE FILLED IN IN THE REQUEST HEADER
;	SF$IRT		DON'T STORE RETURN ADDRESS IN HEADER, RETURN IMMEDIATELY
;	SF$RSP		SET RESPONSE BIT IN FLAGS WORD
;	SF$AST		AN KERNAL AST MUST BE USED TO LOAD TASK CONTEXT BEFORE
;			   CONTROL IS TRANSFERRED TO THE COMPLETION ROUTINE
;	SF$DRF		CALL DRFIN WHEN EXITING
;	SF$NRS		NO RESPONSE EXPECTED TO THIS PACKET - SET FLAG IN HEADER
;	SF$DSW		SET TASK DSW WHEN PACKET RETURNS
;	SF$TCB		THE TCB IS ALREADY IN R5, DON'T GET FROM $TKTCB
;
;	THE FOLLOWING OPCODES ARE DEFINED:
;
;	SN$TSK	SF$BLK!SF$HDR!SF$AST		CALLED BY PRIVILEGED TASKS
;	SN$DIR	SF$BLK!SF$HDR!SF$BIA!SF$AST!SF$DRF!SF$DSW CALLED BY DIRECTIVES
;	SN$IMP	SF$BLK!SF$HDR!SF$BIA!SF$AST!SF$DSW CALLED BY IMPLICIT DIRECTIVES
;	SN$QIO	SF$AST!SF$BIA!SF$HDR!SF$TCB	CALLED BY XXDRV
;	SN$PSR	SF$BLK!SF$HDR!SF$IRT		PSEUDO REQUEST BY OTHER ROUTINE
;	SN$RSP	SF$RSP!SF$IRT			RESPOND TO VMS COMMANDS
;	SN$NOT	SF$NRS!SF$IRT			NOTIFY VMS - NO RESPONSE NEEDED
;	SN$DET	SF$IRT!SF$HDR			DETACHED RETURN
;
;	INPUTS:
;
;	THIS ROUTINE IS CALLED BY THE MACRO CPSEN$ WHICH SETS UP THE STACK IN
;	THE FOLLOWING MANNER:
;
;	  (SP)	RETURN ADDRESS TO CPCALL EXEC MODULE
;	 2(SP)	CALLING ROUTINE'S D SPACE APR5 BIAS
;	 4(SP)	CALLING ROUTINE'S I SPACE APR5 BIAS
;	 6(SP)	CALLING ROUTINE'S RETURN ADDRESS
;	10(SP)	OPCODE
;	12(SP)	BUFFER ADDRESS
;	14(SP)	BUFFER LENGTH
;	16(SP)	ALTERNATE RETURN ADDRESS (FOR IMMEDIATE RETURN)
;
;	OUTPUTS:
;
;	THE RING IS SENT TO VMS

CPRSEN:
;
; FILL IN COMMON FIELDS IN THE HEADER
;
	MOV	12(SP),@#KISAR6		;MAP THE BUFFER
	MOV	#140000,R3		;USE R2 TO MAP HEADER
	BIT	#SF$RSP,10(SP)		;IS THIS A RESPONSE?
	BEQ	10$			;NO
	BIS	#HF$RSP,H$FLAG(R3)	;SET RESPONSE BIT
	BR	20$			;CONTINUE IN COMMON
10$:	BIT	#SF$NRS,10(SP)		;NO RESPONSE EXPECTED?
	BEQ	20$			;NO
	BIS	#HF$NRS,H$FLAG(R3)	;SET NO RESPONSE BIT
20$:	BIT	#SF$HDR,10(SP)		;SHOULD WE FILL IN HEADER FIELDS?
	BNE	25$			;YES, FILL THEM IN
	JMP	130$			;NO, JOIN COMMON CODE TO SEND THE RING
25$:	CLR	H$FLAG(R3)		;CLEAR THE HEADER FLAG WORD
	BIT	#SF$TCB,10(SP)		;SHOULD WE GET THE TCB?
	BNE	27$			;NO, IT'S ALREADY IN R5
	MOV	$TKTCB,R5		;GET THE CURRENT TCB
27$:	BIT	#T3.PRV,T.ST3(R5)	;IS THIS A PRIVILEGED TASK?
	BEQ	30$			;IF EQ NO
	BIS	#HF$PVT,H$FLAG(R3)	;SET PRIVILEGED TASK FLAG
30$:	MOV	T.PCB(R5),R2		;GET THE PCB
	MOV	P.REL(R2),@#KISAR6	;MAP THE HEADER IN APR6
	MOV	H.CUIC(R3),R2		;GET THE CURRENT UIC
	MOV	12(SP),@#KISAR6		;REMAP THE PACKET
	BIT	#174000,R2		;IS THIS A SYSTEM UIC?
	BNE	35$			;IF ANY OF THOSE BITS SET, NO
	BIS	#HF$SYS,H$FLAG(R3)	;SET THE SYSTEM UIC BIT
35$:	BIT	#SF$AST,10(SP)		;WILL WE NEED TO QUEUE AN AST?
	BEQ	40$			;NOPE, JUST CONTINUE
	BIS	#HF$AST,H$FLAG(R3)	;SET THE HEADER FLAG
40$:	BIT	#SF$DSW,10(SP)		;WILL WE NEED TO SET THE DSW?
	BEQ	50$			;NOPE, JUST CONTINUE
	BIS	#HF$DSW,H$FLAG(R3)	;SET THE HEADER FLAG
50$:	BIT	#SF$BLK,10(SP)		;ARE WE GOING TO BLOCK THE TASK?
	BEQ	60$			;NOPE
	BIS	#HF$BLK,H$FLAG(R3)	;MARK AS BLOCKED
	BIS	#TS.RSW,T.STAT(R5)	;BLOCK IT
	CALL	$DRWSE			;REQUEST ANOTHER TASK
60$:
	MOV	R5,H$TCB(R3)		;PUT TCB IN THE HEADER
	MOVB	T.TKI(R5),H$TKI(R3)	;GET THE TASK INDEX
	MOV	T.UCB(R5),R2		;GET TI: UCB
	TST	U.RED(R2)		;UNIT REDIRECTED (CO:)?
	BEQ	70$			;NOPE
	MOV	U.RED(R2),R2		;GET THE REAL UNIT
70$:	MOVB	U.CPUN(R2),H$UNIT(R3)	;GET THE UNIT NUMBER
	CLRB	H$UNIT+1(R3)		;CLEAR RESERVED BYTE
	CLR	H$BIAS(R3)		;ASSUME NO BIAS STORED
	BIT	#SF$BIA,10(SP)		;DO WE WANT TO SAVE THE APR BIAS?
	BEQ	80$			;NO, IT'S A TASK
	MOV	4(SP),H$BIAS(R3)	;SAVE THE APR5 BIAS
80$:	CLR	H$RET(R3)		;ASSUME NO RETURN ADDRESS
	BIT	#SF$IRT,10(SP)		;IMMEDIATE RETURN?
	BNE	90$			;YES, DON'T SAVE RETURN ADDRESS
	MOV	6(SP),H$RET(R3)		;SAVE THE RETURN ADDRESS
90$:	BITB	#HT$SYS,H$TYPE(R3)	;IS THIS PKT FOR CPRSYS?
	BNE	100$			;YES, DON'T DO LOST PACKET CHECKING
;
; WE ONLY SHOW LOST PACKET FOR PACKETS GOING TO THE USER'S AME.  REQUESTS TO
; CPRSYS ALWAYS GO THROUGH.
;
	CMPB	#-1,H$TKI(R3)		;WAS THE TASK INDEX -1?
	BNE	110$			;NO, IT'S OK
;
; THIS TASK NO LONGER HAS AN ASSOCIATED AME.  SET THE STATUS TO IE.PRI AND
; RETURN THE PACKET.  AFTER THE PACKET HAS BEEN RETURNED, ALLOCATE A 1-BLOCK
; CPR PACKET FOR THE LOST PACKET NOTIFICATION.  IF A BLOCK CANNOT BE ALLOCATED,
; JUST EXIT - IT'S NOT CRUCIAL THAT EVERY LOST PACKET BE REPORTED.  IF A BLOCK
; IS ALLOCATED, INSERT THE TASK NAME AND REQUEST TYPE AND SEND THE PACKET TO 
; VMS WITH A DETACHED RETURN.
;
	MOV	@#KISAR6,R0		;GET THE PACKET BIAS IN R0 FOR SENRSP
	CLR	R1			;PACKET IS NOT QUEUED
	MOV	#IE.PRI,H$STAT(R3)	;SET PRIVILEGE VIOLATION STATUS
	MOVB	H$TYPE(R3),-(SP)	;SAVE THE PACKET TYPE -CAN'T BE NEGATIVE
	CALL	SENRSP			;RETURN THE PACKET TO THE USER
	MOV	(SP)+,R4		;RESTORE THE PACKET TYPE
	CLR	R0			;NO FLAGS FOR $CPALO
	MOV	#1,R1			;GET ONE BLOCK
	CALL	CPRALO			;TRY FOR IT
	BCS	150$			;IF NONE AVAILABLE, FORGET IT.
	MOV	R0,@#KISAR6		;MAP THE PACKET
	MOV	#140000,R3		;APR6 BASE ADDRESS
	MOV	#HT$LST,H$TYPE(R3)	;IT'S A LOST PACKET
	CLR	H$FLAG(R3)		;CLEAR THE FLAGS
	CLR	H$RET(R3)		;NO RETURN ADDRESS
	CLR	H$TCB(R3)		;CLEAR THE TCB
	CLRB	H$UNIT(R3)		;SEND TO CPRSX$SYS
	CLRB	H$UNIT+1(R3)		;CLEAR RESERVED BYTE
	MOV	R3,R0			;COPY THE APR6 BASE
	ADD	#H$SIZE,R0		;START OF PARAMETER AREA
	MOV	R4,(R0)+		;MOVE THE PACKET TYPE
	BIT	#SF$TCB,10(SP)		;IS THE TCB ALREADY SET UP?
	BNE	99$			;YES, LEAVE R5 ALONE
	MOV	$TKTCB,R5		;GET THE TCB
99$:	MOV	T.NAM(R5),(R0)+		;GET THE FIRST WORD OF THE NAME
	MOV	T.NAM+2(R5),(R0)+	;GET SECOND WORD OF NAME
	MOV	@#KISAR6,R1		;GET PACKET BIAS BACK
	MOV	#H$SIZE+6,R4		;GET SIZE
	BR	140$			;AND SEND THIS PACKET INSTEAD

100$:
	CLRB	H$UNIT(R3)		;SEND TO CPRSX$SYS
	CLRB	H$UNIT+1(R3)		;CLEAR RESERVED BYTE
;
; MAKE SURE THAT THE PACKET IS AS BIG AS THE LENGTH SPECIFIED AS A SANITY CHECK.
; IF THE TASK IS STARTING A P0 IMAGE, MAKE SURE THAT THE PACKET CONTAINS AN
; EXTRA BLOCK FOR A POTENTIAL P0 ABORT, AND SET THE P0 BIT IN THE TCB
;
110$:
	MOV	14(SP),R1		;GET THE LENGTH
	ADD	#77,R1			;ROUND TO NEXT BLOCK
	ASH	#-6,R1			;GET # OF BLOCKS
	CMPB	#HT$VMS,H$TYPE(R3)	;IS THIS GOING TO START A P0 IMAGE?
	BNE	120$			;NO, CONTINUE
	INC	R1			;ONE EXTRA BLOCK
	BIS	#T4.P0,T.ST4(R5)	;SET P0 BIT IN THE TCB
120$:	CMPB	R1,(R3)			;DO WE HAVE ENOUGH SPACE?
	BLE	130$			;YUP, IT'S OK
	MOV	#IE.ADP,H$STAT(R3)	;MARK AS NO ROOM
	MOV	@#KISAR6,R0		;GET PACKET BIAS
	CLR	R1			;SHOW THAT PACKET IS NOT QUEUED
	CALL	SENRSP			;SEND THE RESPONSE NOW
	BR	150$			;AND EXIT

130$:	MOV	12(SP),R1		;GET THE PACKET ADDRESS
	MOV	14(SP),R4		;GET THE PACKET LENGTH
140$:	CALL	SENPKT			;SEND THE PACKET TO VMS
;
; NOW WE HAVE TO FIX THE STACK, AND RETURN.  THERE ARE FOUR CASES:
;
;	1) A DIRECTIVE.  PULL EVERYTHING OFF THE STACK BUT THE DSW, CALL
;	   $DRFIN TO FINISH THE DIRECTIVE, AND CALL $DRWSE TO RESCHEDULE.
;	2) A $SWSTK CALL.  PULL EVERYTHING OFF THE STACK AND CALL $DRWSE.
;	3) A PSEUDO REQUEST.  PULL THE PARAMETERS OFF THE STACK AND RETURN.
;	4) AN ALTERNATE RETURN.  TREAT JUST LIKE AN IMMEDIATE RETURN
;
150$:	BIT	#SF$IRT,10(SP)		;SHOULD WE RETURN NOW?
	BNE	170$			;IF NE, YES, GO PULL THE PARAMETERS
	TST	16(SP)			;IS THERE AN ALTERNATE RETURN?
	BNE	180$			;YES, RETURN TO THAT ADDRESS
	BIT	#SF$DRF,10(SP)		;CALL $FINDR?
	BNE	160$			;IF NE, YES, SET UP AND CALL
	MOV	#$STACK-22,SP		;GET RID OF EVERYTHING ON THE STACK
	RETURN
160$:
	MOV	#$STACK-24,SP		;GET RID OF EVERYTHING BUT THE DSW
	JMP	$FINDR			;GO TO $DRFIN

170$:	MOV	6(SP),16(SP)		;THE TOP FOUR ELEMENTS ON THE STACK...
180$:	MOV	4(SP),14(SP)		;...NEED TO BE MOVED DOWN
	MOV	2(SP),12(SP)		;...
	MOV	(SP),10(SP)		;...
	ADD	#10,SP			;AND THEN SKIP THE REST OF THE PARAMS
	RETURN

	.PAGE
	.SBTTL	SENPKT - SEND PACKET TO VMS OR QUEUE FOR LATER SENDING
;
; QUEUE THE PACKET, EITHER TO THE OUSTANING QUEUE, OR TO THE WAITING QUEUE
; SEND PACKET TO VMS AND MOVE TO THE NEXT RING.
;
; INPUTS:
;
;	R1	PACKET TO BE SENT
;	R3	140000
;	R4	PACKET LENGTH
;
;	PACKET MAPPED IN APR6
;
; OUTPUTS:
;
;	PACKET SENT TO VMS IF RING AVAILABLE AND INSERTED IN APPROPRIATE QUEUE
;
SENPKT:	CLR	H$LINK(R3)		;THIS WILL BE THE LAST PACKET IN LIST
	MOV	#$CPOUT+2,R2		;ASSUME PACKET TO BE IN OUSTANDING QUEUE
	BIT	#HF$RSP!HF$NRS,H$FLAG(R3) ;WILL THIS REQUEST GET A RESPONSE?
	BEQ	10$			;YES, QUEUE THE PACKET
	CLR	R2			;PACKET NOT TO BE LINKED
10$:	MOV	RNGBAS,@#KISAR6		;MAP THE RINGS
	TST	@SNDRNG			;IS A RING AVAILABLE?
	BPL	20$			;YUP, PUT IT IN OUTSTANDING QUEUE
	MOV	#$CPWAT+2,R2		;PUT PACKET IN WAITING QUEUE INSTEAD
20$:	TST	R2			;QUEUE THIS PACKET?
	BEQ	50$			;NO, JUST SEND IT
	MOV	(R2),-(SP)		;SAVE THE LAST PACKET IN THE QUEUE
	MOV	R1,(R2)			;PUT NEW PACKET AT END OF LIST
	MOV	(SP)+,@#KISAR6		;MAP THE PREVIOUS LAST PACKET
	BNE	30$			;IF PACKET EXISTS, LINK NEW PACKET TO IT
	MOV	R1,-(R2)		;QUEUE EMPTY - PUT PACKET IN LISTHEAD
	BR	40$
30$:	MOV	R1,H$LINK(R3)		;LINK PACKET TO END OF LIST
	TST	-(R2)			;BACK UP TO LISTHEAD
40$:	MOV	RNGBAS,@#KISAR6		;MAP THE RINGS AGAIN
	CMP	R2,#$CPWAT		;WAS THIS RING HELD FOR LATER?
	BEQ	70$			;YUP, DON'T SEND IT NOW
;
; FILL IN THE RING
;
50$:	MOV	SNDRNG,R2		;GET THE ADDRESS OF THE RING
	CLR	(R2)+			; SYNCH WORD
	MOV	R4,(R2)+		; LENGTH
	MOV	R1,(R2)+		; ADDRESS
	BIS	#RF$SYN,@SNDRNG		;TELL VMS THAT THIS ONE IS READY
;
;INTERRUPT IF NECESSARY
;
	TST	@PRVSND			;SHOULD WE INTERRUPT?
	BMI	60$			;NO, JUST CONTINUE
	BIT	#F5.NRT,$FMSK5		;IS THIS A REMOTE NETWORK SYSTEM?
	BNE	55$			;IF NE YES, DON'T DO KXJ SPECIFIC STUFF
	MOV	$KXVC1,@#KXJQIR		;INTERRUPT THE VAX
	BR	60$			;CONTINUE IN COMMON
55$:	MOV	$ACTHD,R0		;GET THE CPRNET TCB	
	BIC	#TS.STP,T.STAT(R0)	;UNSTOP
	BIC	#T2.STP*2!T2.STP,T.ST2(R0) ;CLEAR ALL STOP BITS
	CALL	$SETCR			;REQUEST SCHEDULING OF CPRNET
;
;NOW MOVE TO THE NEXT RING
;
60$:	MOV	SNDRNG,PRVSND		;CURRENT RING IS NOW THE PREVIOUS RING
	ADD	#R$SIZE,SNDRNG		;MOVE POINTER TO NEXT RING
	CMP	SNDRNG,WRAPSN		;DO WE NEED TO WRAP?
	BNE	70$			;NOPE, EXIT
	MOV	FRSTSN,SNDRNG		;START AT THE BEGINNING
70$:	RETURN

KXINI::
KXCAN::
KXOUT::
KXPWF::
	RETURN
	.END